

() `[[<-` 采用S4的方式实现的方法
# $ find . | grep "R$" | xargs grep -n "\[\[<-" --color=auto
#seurat-object-4.0.4/R/seurat.R:2616:  f = '[[<-',


> `[[<-`
.Primitive("[[<-") #??


> getGeneric(`[[<-`)
standardGeneric for "[[<-" defined from package "base"

function (x, i, j, ..., value) 
standardGeneric("[[<-", .Primitive("[[<-"))  #确实是一个S4泛型方法，最后一个value是等号右侧的值
<bytecode: 0x0000000010f56b18>
<environment: 0x0000000009a10170>
Methods may be defined for arguments: x, i, j, value
Use  showMethods([[<-)  for currently available ones.


> showMethods(`[[<-`) #奇怪，这里又说不是 S4 泛型方法
Function "[[<-":
 <not an S4 generic function>

# 看来需要使用正常引号，而不是反引号
> showMethods('[[<-') # 查看 S4 风格实现的类
Function: [[<- (package base)
x="Assay"
x="data.frame"
x="Seurat"



#所有实现该方法的类，S3和S4都包括。
# 可见除了前3个是逗号分隔的(S4)，其他都是点号分隔的(S3)。
> methods(`[[<-`) 
 [1] [[<-,Assay-method           [[<-,data.frame-method     
 [3] [[<-,Seurat-method          [[<-.data.frame            
 [5] [[<-.factor                 [[<-.grouped_df*           
 [7] [[<-.igraph.es*             [[<-.igraph.vs*            
 [9] [[<-.layered*               [[<-.listenv*              
[11] [[<-.numeric_version        [[<-.patchwork*            
[13] [[<-.POSIXlt                [[<-.python.builtin.dict*  
[15] [[<-.python.builtin.object* [[<-.quosures*             
[17] [[<-.reactivevalues*        [[<-.rlang_ctxt_pronoun*   
[19] [[<-.rlang_data_pronoun*    [[<-.shinyoutput*          
[21] [[<-.tbl_df*                [[<-.uneval*               
[23] [[<-.unit*                  [[<-.vctrs_list_of*        
[25] [[<-.vctrs_rcrd*            [[<-.vctrs_sclr*           
[27] [[<-.vctrs_vctr*           
see '?methods' for accessing help and source code









> library(ggplot2)
> methods(`+`)
[1] +,dgTMatrix,dgTMatrix-method +,Matrix,missing-method     
[3] +.Date                       +.gg*                       
[5] +.glue*                      +.IDate*                    
[7] +.igraph*                    +.POSIXt                    
[9] +.vctrs_vctr*               
see '?methods' for accessing help and source code

说明 ggplot2 中使用S3方式定义了+号。



下文的注释说R不允许为S4对象定义S3风格的 `[[<-` 方法。
为什么这么说？不是很理解。后面R tips 我做了尝试：S3、S4风格都可以为S4对象定义方法。

#' @describeIn Seurat-methods Add cell-level metadata or associated objects
#'
#' @param value Additional metadata or associated objects to add; \strong{note}:
#' can pass \code{NULL} to remove metadata or an associated object
#'
#' @return \code{[[<-}: \code{x} with the metadata or associated objects added
#' as \code{i}; if \code{value} is \code{NULL}, removes metadata or associated
#' object \code{i} from object \code{x}
#'
#' @export
#'
setMethod( # because R doesn't allow S3-style [[<- for S4 classes
  f = '[[<-',
  signature = c('x' = 'Seurat'), #依赖第一个参数x的类来分发方法
  # 赋值方式，也就是该函数的使用方式： pbmc_small[["RNA"]] = GetAssay(pbmc_small, "RNA")
  # 一共三个参数，前面1个Seurat对象x，括号一个字符串i，等号右边一个值 value （新的assay）
  definition = function(x, i, ..., value) { 
    x <- UpdateSlots(object = x)

    # Require names, no index setting
    if (!is.character(x = i)) { #如果i不是字符串，报错
      stop("'i' must be a character", call. = FALSE)
    }

    # Allow removing of other object
    # 如果 等号右侧为空，则删除其中的i对象
    if (is.null(x = value)) {
      slot.use <- if (i %in% colnames(x = x[[]])) { #如果i在 meta.data 中，则 slot.use等于 meta.data
        'meta.data'
      } else { # 否则，在Seurat对象x中查找名字为 i 的对象，返回 slot 字符串
        FindObject(object = x, name = i)
      }
      # 如果没找到，则报错
      if (is.null(x = slot.use)) {
        stop("Cannot find object ", i, call. = FALSE)
      }
      # 如果i和默认对象同名，则报错
      if (i == DefaultAssay(object = x)) {
        stop("Cannot delete the default assay", call. = FALSE)
      }
    }


    # remove disallowed characters from object name
    # 从对象名中删除非法字符
    # 如果 等号右侧为空，newi=i，否则 生成合法名字
    newi <- if (is.null(x = value)) {
      i
    } else {
      make.names(names = i)
    }
    # 如果新名字和旧名字不等，表示有非法字符
    if (any(i != newi)) {
      warning(
        "Invalid name supplied, making object name syntactically valid. New object name is ",
        newi,
        "; see ?make.names for more details on syntax validity",
        call. = FALSE,
        immediate. = TRUE
      )
      i <- newi
    }

    # Figure out where to store data | 数据保存的位置
    # (B1) 如果等号右侧的值 是一个 Assay 对象
    slot.use <- if (inherits(x = value, what = 'Assay')) {
      # Ensure we have the same number of cells
      # 如果列数(细胞数) 不一致，报错
      if (ncol(x = value) != ncol(x = x)) {
        stop(
          "Cannot add a different number of cells than already present",
          call. = FALSE
        )
      }

      # Ensure cell order stays the same | 保证细胞顺序一致
      # 如果 等号右侧的 细胞 都在 Seurat对象x中，且顺序不一致
      if (all(Cells(x = value) %in% Cells(x = x)) && !all(Cells(x = value) == Cells(x = x))) {
      	# 循环3个slot，进行排序
        for (slot in c('counts', 'data', 'scale.data')) {
          # 获取数据
          assay.data <- GetAssayData(object = value, slot = slot)
          # 如果不是空的
          if (!IsMatrixEmpty(x = assay.data)) {
          	# 就按照Seurat的细胞顺序排序
            assay.data <- assay.data[, Cells(x = x), drop = FALSE]
          }
          # 赋值。作者前面刚用过 GetAssayData，这里说 SetAssayData 函数目前可能有问题，什么问题？ //todo
          # Use slot because SetAssayData is being weird
          slot(object = value, name = slot) <- assay.data
        }
      }
      'assays'


    # (B2) 如果等号右侧的值 是一个 SpatialImage 对象
    } else if (inherits(x = value, what = 'SpatialImage')) {
      # Ensure that all cells for this image are present
      if (!all(Cells(x = value) %in% Cells(x = x))) {
        stop("", call. = FALSE) #作者还没放报错信息！ //todo
      }
      # Ensure Assay that SpatialImage is associated with is present in Seurat object
      if (!DefaultAssay(object = value) %in% Assays(object = x)) {
        warning(
          "Adding image data that isn't associated with any assay present",
          call. = FALSE,
          immediate. = TRUE
        )
      }
      'images'

    # (B3) 如果等号右侧的值 是一个 Graph 对象
    } else if (inherits(x = value, what = 'Graph')) {
      # Ensure Assay that Graph is associated with is present in the Seurat object
      if (is.null(x = DefaultAssay(object = value))) {
        warning(
          "Adding a Graph without an assay associated with it",
          call. = FALSE,
          immediate. = TRUE
        )
      } else if (!any(DefaultAssay(object = value) %in% Assays(object = x))) {
        stop("Cannot find assay '", DefaultAssay(object = value), "' in this Seurat object", call. = FALSE)
      }
      # Ensure Graph object is in order
      if (all(Cells(x = value) %in% Cells(x = x)) && !all(Cells(x = value) == Cells(x = x))) {
        value <- value[Cells(x = x), Cells(x = x)]
      }
      'graphs'

    # (B4) 如果等号右侧的值 是一个 DimReduc 对象
    } else if (inherits(x = value, what = 'DimReduc')) {
      # All DimReducs must be associated with an Assay
      if (is.null(x = DefaultAssay(object = value))) {
        stop("Cannot add a DimReduc without an assay associated with it", call. = FALSE)
      }
      # Ensure Assay that DimReduc is associated with is present in the Seurat object
      if (!IsGlobal(object = value) && !any(DefaultAssay(object = value) %in% Assays(object = x))) {
        stop("Cannot find assay '", DefaultAssay(object = value), "' in this Seurat object", call. = FALSE)
      }
      # Ensure DimReduc object is in order
      if (all(Cells(x = value) %in% Cells(x = x)) && !all(Cells(x = value) == Cells(x = x))) {
        slot(object = value, name = 'cell.embeddings') <- value[[Cells(x = x), ]]
      }
      'reductions'

    # (B5) 如果等号右侧的值 是一个 Neighbor 对象
    } else if (inherits(x = value, what = "Neighbor")) {
      # Ensure all cells are present in the Seurat object
      if (length(x = Cells(x = value)) > length(x = Cells(x = x))) {
        stop(
          "Cannot have more cells in the Neighbor object than are present in the Seurat object.",
          call. = FALSE
        )
      }
      if (!all(Cells(x = value) %in% Cells(x = x))) {
        stop(
          "Cannot add cells in the Neighbor object that aren't present in the Seurat object.",
          call. = FALSE
        )
      }
      'neighbors'
    # (B6) 如果等号右侧的值 是一个 SeuratCommand 对象
    } else if (inherits(x = value, what = 'SeuratCommand')) {
      # Ensure Assay that SeuratCommand is associated with is present in the Seurat object
      if (is.null(x = DefaultAssay(object = value))) {
        warning(
          "Adding a command log without an assay associated with it",
          call. = FALSE,
          immediate. = TRUE
        )
      } else if (!any(DefaultAssay(object = value) %in% Assays(object = x))) {
        stop("Cannot find assay '", DefaultAssay(object = value), "' in this Seurat object", call. = FALSE)
      }
      'commands'
    # (B7) 如果等号右侧的值 是一个 NULL，则使用前面确定的值
    } else if (is.null(x = value)) {
      slot.use
    } else {
      'meta.data' #否则 meta.data
    }



    #(A1) 如果是 meata.data
    if (slot.use == 'meta.data') {
      # Add data to object metadata
      meta.data <- x[[]]
      cell.names <- rownames(x = meta.data) #行名

      # If we have metadata with names, ensure they match our order
      # 如果是df，且行名非空
      if (is.data.frame(x = value) && !is.null(x = rownames(x = value))) {
      	# 老行名 在 新行名 的下标
        meta.order <- match(x = rownames(x = meta.data), table = rownames(x = value))
        # 按老顺序排列
        value <- value[meta.order, , drop = FALSE]
      }

      # 如果 i 的长度超过1，就是双括号里传入了多个[[c("XX", "YY")]]=value
      # > head(pbmc_small[[ c("groups", "letter.idents")]])
      #               groups letter.idents
      #ATGCCAGAACGACT     g2             A
      #CATGGCCTGTGCAT     g1             A
      if (length(x = i) > 1) {
        # Add multiple pieces of metadata | 也把 value 重复n份
        value <- rep_len(x = value, length.out = length(x = i))
        # 给 meta.data 赋值
        for (index in 1:length(x = i)) {
          meta.data[i[index]] <- value[index]
        }
      # 如果i的长度小于等于1
      } else {
        # Add a single column to metadata
        # 如果有交集：新数据的名字(named vector)，老数据的 cell id
        if (length(x = intersect(x = names(x = value), y = cell.names)) > 0) {
          # 则给 meta.data 命名时，值取 value，cell顺序按照老细胞顺序取，也就是新值没提供的则为NA
          #all.cells=paste0("cell", 1:5)
          #a1=c(5,1,2); names(a1)=paste0("cell", a1)
          #a1
          #a1[all.cells]
          #cell1 cell2  <NA>  <NA> cell5 
          #    1     2    NA    NA     5 
          meta.data[, i] <- value[cell.names]
        # 如果 value 的长度为1 或者 和meta行数相同，或者 value为NULL
        } else if (length(x = value) %in% c(nrow(x = meta.data), 1) || is.null(x = value)) {
          # 直接赋值
          meta.data[, i] <- value
        # 其他情况报错
        } else {
          stop("Cannot add more or fewer cell meta.data information without values being named with cell names", call. = FALSE)
        }
      }


      # Check to ensure that we aren't adding duplicate names
      # 不能重名：新列名，老的内部对象名字: > FilterObjects(pbmc) #[1] "RNA"  "pca"  "umap"
      if (any(colnames(x = meta.data) %in% FilterObjects(object = x))) {
        # 获取重名的名字，报错
        bad.cols <- colnames(x = meta.data)[which(colnames(x = meta.data) %in% FilterObjects(object = x))]
        stop(
          paste0(
            "Cannot add a metadata column with the same name as an Assay or DimReduc - ",
            paste(bad.cols, collapse = ", ")),
          call. = FALSE
        )
      }

      # Store the revised metadata
      slot(object = x, name = 'meta.data') <- meta.data #覆盖新的 meta.data
      # 小结：就是拿出来该slot数据，对输入做各种验证后，添加新的内容，然后再覆盖回原对象的这个slot。
    

    # (A2)如果不是 meta.data 
    } else {
      # Add other object to Seurat object
      # Ensure cells match in value and order
      if (!inherits(x = value, what = c('SeuratCommand', 'NULL', 'SpatialImage', 'Neighbor')) && !all(Cells(x = value) == Cells(x = x))) {
        stop("All cells in the object being added must match the cells in this object", call. = FALSE)
      }

      # Ensure we're not duplicating object names
      duplicate <- !is.null(x = FindObject(object = x, name = i)) && #有以i为名字的内部对象
        !inherits(x = value, what = c(class(x = x[[i]]), 'NULL')) && #且，value不是空，或x[[i]]对应类的对象
        !inherits(x = x[[i]], what = class(x = value))  # 且，x[[i]] 不是 value 对应类的对象
      # 也就是同名的子对象，不能是同类(互相继承自对方)。
      # 否则认为重复，就报错
      if (isTRUE(x = duplicate)) {
        stop(
          "This object already contains ",
          i,
          " as a",
          ifelse(
            test = tolower(x = substring(text = class(x = x[[i]]), first = 1, last = 1)) %in% c('a', 'e', 'i', 'o', 'u'),
            yes = 'n ',
            no = ' '
          ),
          class(x = x[[i]]),
          ", so ",
          i,
          " cannot be used for a ",
          class(x = value),
          call. = FALSE
        )
      }

      # Check keyed objects
      # 先检查带 key 的内部对象
      if (inherits(x = value, what = c('Assay', 'DimReduc', 'SpatialImage'))) {
        # 如果 value 的Key为空，或者 Key 字符串长度为0
        if (length(x = Key(object = value)) == 0 || nchar(x = Key(object = value)) == 0) {
          # 新增Key，就是 i 小写，后加下划线
          Key(object = value) <- paste0(tolower(x = i), '_')
        }

        # 把value 中的Key更新一下，一般返回对象，而不是直接覆盖
        Key(object = value) <- UpdateKey(key = Key(object = value))
        # Check for duplicate keys | 检查重复
        # 获取 老对象中的Key，获取新value中的Key
        object.keys <- Key(object = x)
        # > Key(pbmc)
        #    RNA     pca    umap 
        # "rna_"   "PC_" "UMAP_" 
        
        vkey <- Key(object = value)
        #> Key(pbmc@assays$RNA)
        #[1] "rna_"

        # 如果新对象中的 Key 在 老对象中，且 不等于 i 对应的值
        if (vkey %in% object.keys && !isTRUE(x = object.keys[i] == vkey)) {
          # (C1) 如果 i 对应的 Key 为NA 
          new.key <- if (is.na(x = object.keys[i])) {
            # Attempt to create a duplicate key based off the name of the object being added
            new.keys <- paste0(
              #一个变2个： 在i后面加 空字符串，或2位随机字母。
              paste0(tolower(x = i), c('', RandomName(length = 2L))), 
              '_'
            )

            # Select new key to use | 选择不在 老对象中的名字下标
            key.use <- min(which(x = !new.keys %in% object.keys))

            # 如果是无限的，则随机生成17字符，否则使用第二个只有刚才下标的字符
            new.key <- if (is.infinite(x = key.use)) {
              RandomName(length = 17L)
            } else {
              new.keys[key.use]
            }

            # 警告，已经替换了 Key
            warning(
              "Cannot add objects with duplicate keys (offending key: ",
              Key(object = value),
              "), setting key to '",
              new.key,
              "'",
              call. = FALSE
            )
            new.key

          # (C2) 如果 i 对应的 Key 已经存在，就用原来的Key
          } else {
            # Use existing key
            warning(
              "Cannot add objects with duplicate keys (offending key: ",
              Key(object = value),
              ") setting key to original value '",
              object.keys[i],
              "'",
              call. = FALSE
            )
            object.keys[i]
          }

          # Set new key
          Key(object = value) <- new.key
        }
      }




      # For Assays, run CalcN | 如果 value 是 Assay 类
      if (inherits(x = value, what = 'Assay')) {
        # 如果 i 不在 x 中，
        # 或者 i 在x中， 且 两个 Assay中的counts 不全相等
        if ((!i %in% Assays(object = x)) |
            (i %in% Assays(object = x) && !identical(
              x = GetAssayData(object = x, assay = i, slot = "counts"),
              y = GetAssayData(object = value, slot = "counts"))
            )) {

          # 使用新value，重新计算 meta.data 中的 nGene 和 nCount
          n.calc <- CalcN(object = value)

          # 如果结果非空，给列名加上 i 后缀，用_分隔
          if (!is.null(x = n.calc)) {
            names(x = n.calc) <- paste(names(x = n.calc), i, sep = '_')
            x[[names(x = n.calc)]] <- n.calc #直接覆盖到 meta.data
          }

        }

      }


      # When removing an Assay, clear out associated DimReducs, Graphs, and SeuratCommands
      # 当需要删除 Assay 时，需要删除关联的 DimReducs, Graphs, and SeuratCommands
      if (is.null(x = value) && inherits(x = x[[i]], what = 'Assay')) {

        # 获取这几个内部类的 对象名
        objs.assay <- FilterObjects(
          object = x,
          classes.keep = c('DimReduc', 'SeuratCommand', 'Graph')
        )

        # 过滤掉： 默认类，且不是 全局为F
        objs.assay <- Filter(
          f = function(o) {
            return(all(DefaultAssay(object = x[[o]]) == i) && !IsGlobal(object = x[[o]]))
          },
          x = objs.assay
        )
        # 删除这些对象
        for (o in objs.assay) {
          x[[o]] <- NULL
        }

      }


      # If adding a command, ensure it gets put at the end of the command list
      # 如果添加命令了，注意添加到最后
      if (inherits(x = value, what = 'SeuratCommand')) {
        # > names(pbmc@commands)
        #[1] "NormalizeData.RNA"        "FindVariableFeatures.RNA"
        #[3] "ScaleData.RNA"            "RunPCA.RNA"              
        #[5] "RunUMAP.RNA.pca"          "FindNeighbors.RNA.pca"   
        #[7] "FindClusters"
        
        #> class(pbmc@commands[[1]])
        #[1] "SeuratCommand"
        #attr(,"package")
        #[1] "SeuratObject"
        slot(object = x, name = slot.use)[[i]] <- NULL #清空该命令
        slot(object = x, name = slot.use) <- Filter( #过滤：留下非空的
          f = Negate(f = is.null),
          x = slot(object = x, name = slot.use)
        )
      } #先跳过 Command 类 //todo

      # 赋值语句
      slot(object = x, name = slot.use)[[i]] <- value
      # 过滤：保留非空
      slot(object = x, name = slot.use) <- Filter(
        f = Negate(f = is.null),
        x = slot(object = x, name = slot.use)
      )
    }

    # 回收内存
    CheckGC()
    return(x) #函数返回
  }
)












(2) CheckGC() 回收内存

> Seurat:::CheckGC
function () 
{
    if (getOption(x = "Seurat.memsafe")) {
        gc(verbose = FALSE)
    }
}
<bytecode: 0x00000000194959e8>
<environment: namespace:Seurat>


> getOption(x = "Seurat.memsafe")
[1] FALSE
这个if(F)，意味着 CheckGC() 中啥也不执行。


查看Seurat的全局设置都有哪些:
> grep("Seurat",names(options()), value = T)
[1] "Seurat.checkdots"          "Seurat.limma.wilcox.msg"   "Seurat.memsafe"           
[4] "Seurat.Rfast2.msg"         "Seurat.warn.umap.uwot"     "Seurat.warn.vlnplot.split"



$ find . | grep "R$" | xargs grep -n "Seurat.memsafe" --color=auto
grep: ./seurat-4.1.0/R: Is a directory
./seurat-4.1.0/R/utilities.R:1849:  if (getOption(x = "Seurat.memsafe")) {
./seurat-4.1.0/R/zzz.R:6:#'   \item{\code{Seurat.memsafe}}{global option to call gc() after many operations.
./seurat-4.1.0/R/zzz.R:31:  Seurat.memsafe = FALSE,



#' @section Package options:
#'
#' Seurat uses the following [options()] to configure behaviour:
#'
#' \describe{
#'   \item{\code{Seurat.memsafe}}{global option to call gc() after many operations.
#'   This can be helpful in cleaning up the memory status of the R session and
#'   prevent use of swap space. However, it does add to the computational overhead
#'   and setting to FALSE can speed things up if you're working in an environment
#'   where RAM availability is not a concern.}
#'   \item{\code{Seurat.warn.umap.uwot}}{Show warning about the default backend
#'   for \code{\link{RunUMAP}} changing from Python UMAP via reticulate to UWOT}
#'   \item{\code{Seurat.checkdots}}{For functions that have ... as a parameter,
#'   this controls the behavior when an item isn't used. Can be one of warn,
#'   stop, or silent.}
#'   \item{\code{Seurat.limma.wilcox.msg}}{{Show message about more efficient
#'   Wilcoxon Rank Sum test available via the limma package}}
#'   \item{\code{Seurat.Rfast2.msg}}{{Show message about more efficient
#'   Moran's I function available via the Rfast2 package}}
#'   \item{\code{Seurat.warn.vlnplot.split}}{Show message about changes to
#'   default behavior of split/multi violin plots}
#' }
#'
#' @docType package
#' @rdname Seurat-package
#' @name Seurat-package
#'
"_PACKAGE"

# 定义的环境变量
seurat_default_options <- list(
  Seurat.memsafe = FALSE,
  Seurat.warn.umap.uwot = TRUE,
  Seurat.checkdots = "warn",
  Seurat.limma.wilcox.msg = TRUE,
  Seurat.Rfast2.msg = TRUE,
  Seurat.warn.vlnplot.split = TRUE
)

AttachDeps <- function(deps) {
  for (d in deps) {
    if (!paste0('package:', d) %in% search()) {
      packageStartupMessage("Attaching ", d)
      attachNamespace(ns = d)
    }
  }
}

# library() 事件触发的函数
.onAttach <- function(libname, pkgname) {
  AttachDeps(deps = 'SeuratObject')
}

# 
.onLoad <- function(libname, pkgname) {
  # 获取当前 环境变量
  op <- options()
  # Seurat选项中 还没有设置到 当前中的
  toset <- !(names(x = seurat_default_options) %in% names(x = op))
  # 如果有没设置的，则设置上默认值
  if (any(toset)) options(seurat_default_options[toset])
  # 如果没有左值，则不返回任何结果
  invisible(x = NULL)
}
